home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / VE208D~1.CLS < prev    next >
Text File  |  1997-06-14  |  3KB  |  103 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "CVectorInt"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. Option Explicit
  11.  
  12. Public Enum EErrorVectorInt
  13.     eeBaseVectorInt = 13320     ' CVectorInt
  14. End Enum
  15.  
  16. Private ai() As Integer
  17. Private iLast As Long
  18. Private cChunk As Long
  19.  
  20. Private Sub Class_Initialize()
  21.     cChunk = 10     ' Default size can be overridden
  22.     ReDim Preserve ai(1 To cChunk) As Integer
  23.     iLast = 1
  24. End Sub
  25.  
  26. ' Friend properties to make data structure accessible to walker
  27. Friend Property Get Vector(ByVal i As Long) As Integer
  28.     BugAssert i > 0 And i <= iLast
  29.     Vector = ai(i)
  30. End Property
  31.  
  32. ' NewEnum must have the procedure ID -4 in Procedure Attributes dialog
  33. ' Create a new data walker object and connect to it
  34. Public Function NewEnum() As IEnumVARIANT
  35. Attribute NewEnum.VB_UserMemId = -4
  36.     ' Create a new iterator object
  37.     Dim vectorwalker As CVectorIntWalker
  38.     Set vectorwalker = New CVectorIntWalker
  39.     ' Connect it with collection data
  40.     vectorwalker.Attach Me
  41.     ' Return it
  42.     Set NewEnum = vectorwalker.NewEnum
  43. End Function
  44.  
  45. ' Item is the default property
  46. Property Get Item(ByVal i As Long) As Integer
  47. Attribute Item.VB_UserMemId = 0
  48.     BugAssert i > 0
  49.     Item = ai(i)
  50. End Property
  51.  
  52. Property Let Item(ByVal i As Long, ByVal iItemA As Integer)
  53.     BugAssert i > 0
  54.     On Error GoTo FailLetItem
  55.     ai(i) = iItemA
  56.     If i > iLast Then iLast = i
  57.     Exit Property
  58. FailLetItem:
  59.     If i > UBound(ai) Then
  60.         ReDim Preserve ai(1 To i + cChunk) As Integer
  61.         Resume      ' Try again
  62.     End If
  63.     ErrRaise Err.Number     ' Other VB error for client
  64. End Property
  65.  
  66. Property Get Last() As Long
  67.     Last = iLast
  68. End Property
  69. Property Let Last(iLastA As Long)
  70.     BugAssert iLastA > 0
  71.     ReDim Preserve ai(1 To iLastA) As Integer
  72.     iLast = iLastA
  73. End Property
  74.  
  75. Property Get Chunk() As Long
  76.     Chunk = cChunk
  77. End Property
  78. Property Let Chunk(cChunkA As Long)
  79.     BugAssert cChunkA > 0
  80.     cChunk = IIf(cChunkA < 100, cChunkA, 100)
  81. End Property
  82.  
  83. #If fComponent = 0 Then
  84. Private Sub ErrRaise(e As Long)
  85.     Dim sText As String, sSource As String
  86.     If e > 1000 Then
  87.         sSource = App.ExeName & ".VectorInt"
  88.         Select Case e
  89.         Case eeBaseVectorInt
  90.             BugAssert True
  91.        ' Case ee...
  92.        '     Add additional errors
  93.         End Select
  94.         Err.Raise COMError(e), sSource, sText
  95.     Else
  96.         ' Raise standard Visual Basic error
  97.         sSource = App.ExeName & ".VBError"
  98.         Err.Raise e, sSource
  99.     End If
  100. End Sub
  101. #End If
  102.  
  103.